home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 072 - EXFER 4.1 4.2.dsk / EXFER.SEG.S < prev    next >
Text File  |  2019-02-17  |  29KB  |  795 lines
  1.                          ; *****************************
  2.                          ;
  3.                          ;            EXfer:
  4.                          ; The Extended Transfer Module
  5.                          ;
  6.                          ;  This program is for use on
  7.                          ;  the ProDOS version of GBBS
  8.                          ;         "Pro" 1.3
  9.                          ;
  10.                          ;    Created and Copyrighted
  11.                          ;         1986 and 1987
  12.                          ;      by Mike Golaszewski
  13.                          ;
  14.                          ;    Copyright 1988 by G-Tech
  15.                          ;      All Rights Reserved
  16.                          ;
  17.                          ; *****************************
  18.  
  19.                          ; user segment, version 4.2
  20.  
  21.                          ; Thanks to L&L Productions for protocol.up and protocol.down!
  22.  
  23.                          ; created 6/20/88 - modified 7/25/88
  24.                          ; jpe  Last Edited 9-26-88
  25.  
  26.                          ; define linkable labels
  27.  
  28.           public prompt
  29.           public send.2
  30.           public terminate
  31.  
  32.                          ; store existing variables
  33.  
  34. enter
  35.           on nocar goto terminate
  36.           fill ram2,64,0:print \"XT: Loading EXfer, please hold...."
  37.           store "d:variables":gosub store:clear
  38.           gosub recall:screen$=chr$(13,2)+chr$(12):xt$=chr$(13)+"XT: "
  39.           byte=ram2:v=0:f$="b:sys.questions":gosub chkfil:close
  40.           if not(a) then v=13
  41.           f$="d:xt.users":gosub chkfil:close:if a create f$
  42.           open #1,f$:position #1,32,un:input #1,lc$
  43.           position #1,32,un,10:read #1,ram2,6:close
  44.           xm=byte(0):cr=byte(2)+byte(3)*256
  45.           if not(byte(1)) then cr=250:lc$=mid$(" "+date$,2)
  46.           ld$=lc$:pt=byte(5):pc=byte(4):b$=right$(lc$,3)+left$(lc$,5):lc$=b$
  47.           when$=ram2+16:ed=edit(5):if not(v) goto begin
  48.           byte=ram+37:dl=byte(3)+nibble(3)*256
  49.           ul=byte(4)+nibble(4)*256:byte=ram2
  50.  
  51.                          ; check for bit map file
  52.  
  53. begin
  54.           f$="d:xt.bitmap":gosub chkfil:close
  55.           if (not(a)) goto begin.1:else fill ed+1,255,255
  56.           create f$:open #1,f$:write #1,ed+1,255:close
  57.           f$="d:xt.volumes":kill f$:create f$
  58.  
  59.                          ; get XMODEM type
  60.  
  61. begin.1
  62.           print screen$
  63.           print "                    :::::::::::::::::::::::::::::::::::::"
  64.           print "                   : EXfer: The Extended Transfer Module :"
  65.           print "                   :             Version 4.2.1           :"
  66.           print "                   :   A.1 Computing~s Professional BBS  :"
  67.           print "                   :   Last Date in EXfer -->"ld$"    :"
  68.           print "                    :::::::::::::::::::::::::::::::::::::"
  69.           if not(info(2)) input @2 \"Press [RETURN]...." i$:goto start
  70.           if byte(1) goto start
  71.           print xt$      ;:input @2 'Does your terminal program support
  72.              Ymodem "batch" transfers? ([Y]/N):' i$
  73.           i$=left$(i$,1):if i$<>"N" pt=1:xm=1:else xm=0:pt=0
  74.           print xt$      ;:input @2 "Are you using PC Pursuit? (Y/[N]):" i$
  75.           if i$<>"Y" pc=140:else pc=190
  76.           byte(0)=xm:byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256:byte(4)=pc
  77.           byte(5)=pt:open #1,"d:xt.users":position #1,32,un:print #1,date$
  78.           position #1,32,un,10:write #1,ram2,6:close
  79.  
  80.                          ; try to access default library
  81.  
  82. start
  83.           print \"XT: Please hold...."
  84.           bb=c:gosub log:if bf$="" goto start.2
  85.           if not(b2) gosub lsec:goto exit.1
  86.  
  87.                          ; got it, enter EXfer
  88.  
  89. start.1
  90.           gosub getslt:goto prompt
  91.  
  92.                          ; library does not exist
  93.  
  94. start.2
  95.           if not(info(5)) print xt$;chr$(7)"Can't find default library....":goto exit.1
  96.           tone(30,30):print xt$"Source library does not exist...."
  97.           input @2 "    Create? ([Y]/N):" i$:if i$<>"N" goto create:else goto exit.1
  98.  
  99.                          ; get a command
  100.  
  101. prompt
  102.           on nocar goto terminate:ready d2$
  103.           x=(clock(2)-clock(1))/60:x$=right$("0"+str$(x),2)
  104.           if x=0 then x$="--":else if (info(5)) or (clock(1)=0) then x$="::"
  105.           free:clear key:print \chr$(14)"["x$"][EXfer Level] Option? (?=Help):";
  106.           if zz=1 then zz=0:goto command
  107.           if zz=3 goto command:else get i$:print chr$(8)" ";chr$(8);
  108.  
  109.                          ; check for normal command
  110.  
  111. command
  112.           push prompt
  113.           if (i$="B") and (pt=1) goto batch
  114.           if i$="C" goto aux
  115.           if i$="D" f$="directory":goto aux.aux
  116.           if i$="F" f$="search":goto aux.aux
  117.           if i$="G" f$="global":goto aux.aux
  118.           if i$="H" goto aux
  119.           if i$="I" f$="aux.info":goto aux.aux
  120.           if (i$="J") or (i$="L") goto volume
  121.           if i$="K" goto aux
  122.           if i$="M" goto aux
  123.           if i$="N" f$="new":goto aux.aux
  124.           if i$="Q" f$="new":goto aux.aux
  125.           if i$="R" goto receive
  126.           if i$="S" goto send
  127.           if i$="T" goto hangup
  128.           if i$="V" goto aux
  129.           if i$="X" goto exit
  130.           if i$="W" goto aux
  131.           if i$="Y" then c=bb:flag(39)=0:pt=0:byte(1)=0:pop:goto begin.1
  132.           if (i$="?") or (i$="/") goto menu
  133.  
  134.                          ; check for librarian command
  135.  
  136.           if (not(lb)) and (not(info(5))) goto prompt.1
  137.           if i$="+" and (info(5)) then pt=1:return
  138.           if i$="A" and (info(5)) pop:link "a:exfer.sys","add"
  139.           if i$="E" and (info(5)) pop:link "a:exfer.sys","external"
  140.           if (i$="$") or (i$="-") pop:link "a:exfer.sys","credit"
  141.           if i$="O" pop:link "a:exfer.sys","sort"
  142.           if i$="P" and (info(5)) pop:ob=bb:goto create
  143.           if (i$="*") and (info(5)) input @2 "ProDOS: " i$:if i$ use "b:xdos",i$
  144.           if (i$="2") and (info(5)) pop:link "a:exfer.aux.2"
  145.                          ; not a command
  146.  
  147. prompt.1
  148.           print " "chr$(8);:return
  149.  
  150.                          ; link to the auxilliary command segment
  151.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  152.  
  153. aux
  154.           pop:link "a:exfer.aux"
  155.  
  156. aux.aux
  157.           pop:link "a:exfer.aux","aux.aux"
  158.  
  159.                          ; display a menu
  160.                          ; ~~~~~~~~~~~~~~
  161.  
  162. menu
  163.           print screen$\\s$:l=key(1)
  164.           f$="d:mnu.exfer80"
  165.  
  166. menu.1
  167.           open #1,f$:input #1,x$:setint(" ")
  168.           for l=1 to len(x$):addint(mid$(x$,l,1))
  169.           next:copy #1
  170.           if key(1) then a=key(0):goto menu.cancel
  171.           if key(3) goto menu.key
  172.           if (lb) and (f$<>"d:mnu.sysop") goto menu.sys
  173.  
  174. menu.cancel
  175.           close:setint(""):return
  176.  
  177. menu.key
  178.           close:setint(""):i$=chr$(key(0))
  179.           zz=1:print:return
  180.  
  181. menu.sys
  182.           close:setint(""):f$="d:mnu.sysop":goto menu.1
  183.  
  184.                          ; send a file
  185.                          ; ~~~~~~~~~~~
  186.  
  187.                          ; get name & verify it
  188.  
  189. send
  190.           if not(b3) goto lsec:else if zz=3 then zz=0:goto xsend
  191.           i$="N":if pt input @2 "Use Ymodem to download? ([Y]/N):" i$
  192.           i$=left$(i$,1):if i$<>"N" goto batch:else zz=3:i$="S":return
  193.  
  194. xsend
  195.           input @2 "Send:" i$:if i$="" return
  196.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto send.x
  197.           i$=left$(i$+chr$(32,14),15):gosub read
  198.           if not(l) goto nfile
  199.  
  200. send.x
  201.           if (l<0) goto nfile
  202.           if not(byte(9)) goto unval
  203.           na$=f$:gosub name:f$=bf$+f$:gosub chkfil
  204.           if a close:goto nfile
  205.  
  206.                          ; compute time of transfer
  207.  
  208.           close:x=((byte(10)+byte(11)*256)/2)*dm
  209.           if ((cr+1-x)<0) and (not(lb)) print '
  210. XT:       You don'"'"'t have enough credits to
  211.              download this file!':return
  212.           bs=byte(10)+byte(11)*256
  213.           gosub sendtime:print xt$'Estimated time of transfer is 'a'
  214.              minutes, 'c' seconds.':if clock(2)=0 goto send.1
  215.           if x<a print xt$;chr$(7)'You do not have enough time left to
  216.              download this file!':return
  217.  
  218. send.1
  219.           print xt$"Press <CR> to engage intelligent Xmodem....";:get i$:print
  220.           print xt$"Sending "bs+2" blocks...."
  221.           use "d:protocol.down",pc,0,f$
  222.  
  223.                          ; update the record
  224.  
  225. send.2
  226.           on nocar goto terminate
  227.           d=0:if not(v) then byte=ram+29:byte(2)=byte(2)+1:byte=ram2:d=1
  228.           if v=13 then dl=dl+(peek(ed+3)=255):d=(peek(ed+3)=255)
  229.           byte(18)=byte(18)+1:nb=l
  230.           if d and (not(lb)) then x=((byte(10)+byte(11)*256)/2)*dm:if dm print '
  231. XT:       'x' credits deducted.':cr=cr-x
  232.           push getslt:goto write
  233.  
  234.                          ; send batch files
  235.                          ; ~~~~~~~~~~~~~~~~
  236.  
  237. batch
  238.           if not(b3) goto lsec:else print "Send batch files...."
  239.           print '
  240. XT:       Please enter your file list now.  A blank entry will exit the selection
  241.              mode.'\:y=1:flag=ram2+21:fill ram2+20,44,0:pt=2:bs=0:d=cr
  242.  
  243.                          ; get a file name or number
  244.  
  245. batch.1
  246.           print "Enter batch file #"right$("00"+str$(y),3);
  247.           input @2 ":" i$:if i$="" goto batch.2
  248.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto batch.x
  249.           i$=left$(i$+chr$(32,14),15):gosub read
  250.           if not(l) print chr$(8,24)"FILE DOESN'T EXIST!"chr$(7):goto batch.1
  251.  
  252.                          ; make sure file is there and validated
  253.  
  254. batch.x
  255.           if l<0 print chr$(8,24)"FILE DOESN'T EXIST!"chr$(7):goto batch.1
  256.           if not(byte(9)) print chr$(8,24)"FILE MUST BE VALIDATED!"chr$(7):goto batch.1
  257.           if ty$="LST" print chr$(8,24)"ADDING LIST FILES!"chr$(7):goto lbatch
  258.           if lb gosub batch.d:goto batch.1
  259.  
  260.                          ; check price & see if user has enough credits
  261.  
  262.           z=((byte(10)+byte(11)*256)/2)*dm
  263.           if (d+1)-z<0 print chr$(8,24)"INSUFFICIENT CREDITS!"chr$(7):goto batch
  264.           d=d-z:gosub batch.d:goto batch.1
  265.  
  266.                          ; ::::::::::::::::::::::::::::::::
  267.                          ; we have a file macro, process it
  268.                          ; ::::::::::::::::::::::::::::::::
  269.  
  270. lbatch
  271.           gosub name:f$=bf$+f$:open #2,f$
  272.  
  273.                          ; fake an input to the user
  274.  
  275. lbatch.1
  276.           input #2,i$:if i$="" close:goto batch.1
  277.           if left$(i$,1)=";" goto lbatch.1
  278.           print "Enter batch file #"right$("00"+str$(y),3)": "i$
  279.           i$=left$(i$+chr$(32,14),15):gosub read
  280.           if not(l) print chr$(8,24)"FILE DOESN'T EXIST!"chr$(7):goto lbatch.1
  281.  
  282.                          ; process what we have
  283.  
  284.           if not(byte(9)) print chr$(8,24)"FILE MUST BE VALIDATED!"chr$(7):goto lbatch.1
  285.           if lb gosub batch.d:goto lbatch.1
  286.  
  287.                          ; check the price & see if user has enough credits
  288.  
  289.           z=((byte(10)+byte(11)*256)/2)*dm
  290.           if (d+1)-z<0 print chr$(8,24)"INSUFFICIENT CREDITS!"chr$(7):goto lbatch.1
  291.           d=d-z:gosub batch.d:goto lbatch.1
  292.  
  293.                          ; ::::::::::::::::::::::::::::::::
  294.                          ; ready to send files using Ymodem
  295.                          ; ::::::::::::::::::::::::::::::::
  296.  
  297.                          ; do an "estimated time of transfer" calculation
  298.  
  299. batch.2
  300.           y=y-1:if y=0 then flag=ram+22:pt=1:return
  301.           print xt$"Send "y;:input @2 " files? ([Y]/N):" i$
  302.           if i$="N" then flag=ram+22:pt=1:return
  303.           bs=bs+y/4:gosub sendtime:print '
  304. XT:       Estimated time of transfer is 'a' minutes, 'c' seconds.'
  305.           if (clock(2)=0) or (x>a) goto batch.3:else print '
  306. XT:       'chr$(7)'You do not have enough time left to download these files!'
  307.           flag=ram+22:pt=1:return
  308.  
  309.                          ; search for a file that has been marked
  310.  
  311. batch.3
  312.           bs=(bs-y/8):poke ram2+20,y:print xt$'Sending 'y' files....'
  313.           for l=2 to 255:if flag(l) goto batch.4:else next:goto batch.5
  314.  
  315.                          ; found a marked file, get its ProDOS filename
  316.  
  317. batch.4
  318.           open #1,d1$:position #1,32,l
  319.           input #1,i$:input #1,ty$:read #1,ram2+9,10
  320.           close:na$=i$:gosub name:f$=bf$+f$
  321.  
  322.                          ; send the file using Ymodem
  323.  
  324.           use "d:protocol.down",pc,1,f$:byte(18)=byte(18)+1
  325.           if not(v) then byte=ram+29:byte(2)=byte(2)+1:byte=ram2
  326.           if v=13 then dl=dl+1
  327.  
  328.                          ; update the "number of times downloaded" counter & search for more files
  329.  
  330.           open #1,d1$:position #1,32,l:print #1,na$
  331.           print #1,ty$:write #1,ram2+9,10:close:next
  332.  
  333.                          ; inform remote of EOT, deduct credits, reset FLAG pointer
  334.  
  335. batch.5
  336.           use "d:protocol.down",pc,1:flag=ram+22:pt=1
  337.           if dm and (not(lb)) print xt$;cr-d;" credits deducted!":cr=d:d=0
  338.           return
  339.  
  340.                          ; SUBROUTINE - display & add block size, increment file counter
  341.  
  342. batch.d
  343.           z=((byte(10)+byte(11)*256)-1)*4
  344.           print chr$(8,24);i$"  ["right$("000"+str$(z),4)"]"
  345.           if flag(l+1)=0 then y=y+1:bs=bs+(byte(10)+byte(11)*256)-(byte(10)>0)
  346.           flag(l+1)=1:return
  347.  
  348.                          ; SUBROUTINE - find an empty message entry
  349.  
  350. findinfo
  351.           if msg(a) then a=a+1:else d=a:return
  352.           if a>msg(0) then d=a:return
  353.           goto findinfo
  354.  
  355.                          ; receive a file
  356.                          ; ~~~~~~~~~~~~~~
  357.  
  358.                          ; get filename & check for conflicts
  359.  
  360. receive
  361.           if not(b4) goto lsec:else if nb=255 goto dfull
  362.           if zz=3 then zz=0:goto recvx
  363.           i$="N":if pt input @2 "Use Ymodem to upload files? ([Y]/N):" i$
  364.           i$=left$(i$,1):if i$<>"N" goto rbch:else zz=3:i$="R":return
  365.  
  366. recvx
  367.           d=0:input @2 "Receive:" i$:if i$="" return
  368.           na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  369.           gosub name:f$=bf$+f$:gosub chkfil:close
  370.           if a and not(l) goto rec.a
  371.           if lb goto rec.1:else print '
  372. XT:       'chr$(7)"Duplicate name on ProDOS volume!":return
  373.  
  374.                          ; see what sysop wishes to do with duplicate
  375.  
  376. rec.1
  377.           if l then nb=l
  378.           input @2 \"XT: File exists....overwrite? ([Y]/N):" i$
  379.           if i$="N" return:else kill f$:d=byte(14)
  380.  
  381.                          ; get the file
  382.  
  383. rec.a
  384.           x$=left$(i$+chr$(32,14),15)
  385.           create f$:print xt$"Ready to receive...."
  386.           y=clock(2):clock(2)=0:use "d:protocol.up",pc,0,f$:clock(2)=y
  387.           if not(v) then nibble(3)=nibble(3)+1:else ul=ul+(peek(ed+3)=255)
  388.           if (peek (10)=255) and (info(2)>0) print '
  389. XT:       The file you uploaded was received in
  390.              error and has been automatically
  391.              deleted....':kill f$:return
  392.  
  393.                          ; compute some file info
  394.  
  395.           gosub dtype:gosub size:if not(lb) then cr=cr+(a/2)*um
  396.           if um and (not(lb)) print xt$"You got "(a/2)*um" credits for this file!"
  397.           gosub sfile:byte(14)=0:if dd=1 then dd=0:x=254:gosub type:ty$="DDD"
  398.  
  399.                          ; ask for a description
  400.  
  401.           on nocar goto rec.4
  402.           if d print xt$'Do you want to change the existing
  403.              file information? ([Y]/N):';:else print xt$'Would you like to enter a short
  404.              description of this upload? ([Y]/N):';
  405.           input @2 i$:i$=left$(i$,1):if i$="N" goto rec.3
  406.           if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
  407.           edit(0):gosub edesc:if not(edit(2)) goto rec.3
  408.           if d then byte(14)=d:kill #msg(d):update:goto rec.i
  409.           a=1:gosub findinfo
  410.  
  411. rec.i
  412.           kill #msg(d):print #msg(d),un:print #6,na$
  413.           print #6,"Uploader: "a1$" "a2$" [#"un"]"
  414.           print #6,"Uploaded: "date$" "time$\:copy #8,#6
  415.           msg(d)=255:update
  416.  
  417. rec.3
  418.           if d then byte(14)=d
  419.           if not(v) print xt$'If there is a problem with this
  420.              upload, use the "K" command to
  421.              delete it....'
  422.           push getslt:if nb<>byte(4) goto write:else goto update
  423.  
  424.                          ; loss of carrier - save file and then hang up
  425.  
  426. rec.4
  427.           if d then byte(12)=d
  428.           push terminate:if nb<>byte(4) goto write:else goto update
  429.  
  430.                          ; receive files using Ymodem batch
  431.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  432.  
  433. rbch
  434.           print '
  435. XT:       Ymodem batch will not overwrite existing files. If a file exists you
  436.              must delete it before transfer!'
  437.           x=0:d=0:print \xt$"Receiving batch; begin sending files now...."
  438.  
  439.                          ; receive a file
  440.  
  441. rbch.1
  442.           i$=chr$(32,15):use "d:protocol.up",pc,1,bf$,i$:if i$=chr$(32,15) goto rbch.2
  443.           na$=i$:i$=left$(i$+chr$(32,14),15):gosub read:f$=bf$+na$:na$=i$
  444.           if peek(10)=255 kill f$:gosub trerr:goto rbch.1
  445.           p=0:if l then p=byte(14):nb=l
  446.           b=x:gosub dtype:x=b:b=a:gosub size:if um and (not(lb)) then d=d+(a/2)*um
  447.           byte(14)=p:gosub sfile:a=b:byte(14)=p:x=x+1
  448.           if nb<>byte(4) gosub write:else gosub update
  449.           gosub getslt:goto rbch.1
  450.  
  451. rbch.2
  452.           print xt$      ;x;" files received successfuly.":if um and (not(lb)) print '
  453. XT:       You received 'd' credits for your batch upload.':cr=cr+d
  454.           d=0:return
  455.  
  456.                          ; log to a different library
  457.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  458.  
  459.                          ; get new volume & see if it exsists
  460.  
  461. volume
  462.           print "Go to a different library...."\xt$"Current library is #"bb
  463.           input @2 "    Go to library [?]..." i$:if i$="" return
  464.           if i$="?" goto vol.2:else a=val(i$):if (a<1) or (a>255) print '
  465. XT:       'chr$(7)"That library doesn't exist!":return
  466.  
  467.                          ; try to log to library
  468.  
  469.           ob=bb:bb=a:gosub log:if bf$="" then l=bb:gosub biterr:goto vol.1
  470.           if not(b2) gosub lsec:bb=ob:goto log
  471.           print xt$"Please hold....":gosub getslt
  472.           f$="directory":goto aux.aux
  473.  
  474.                          ; find out if this library is to be created
  475.  
  476. vol.1
  477.           if not(info(5)) print '
  478. XT:       'chr$(7)"That library doesn't exist!":bb=ob:goto log
  479.           tone(20,20):input @2 \"XT: Library doesn't exist....create? ([Y]/N):" i$
  480.           if i$="N" then bb=ob:goto log:else goto create
  481.  
  482.                          ; scan bit map for available libraries
  483.  
  484. vol.2
  485.           print screen$"XT: You may access the following...."\\s$\
  486.           open #1,"d:xt.bitmap":read #1,ed+1,255:close
  487.           open #1,"d:xt.volumes":for l=1 to 255
  488.           setint(1):x=peek(ed+l):if key(1) then l=255:next:goto vol.4
  489.           if x>34 next:goto vol.4
  490.           if not(x) goto vol.3:else if flag(x) goto vol.3
  491.           next:goto vol.4
  492.  
  493. vol.3
  494.           position #1,32,l:input #1,x$
  495.           print "["right$("00"+str$(l),3)"]: "x$:next
  496.  
  497.                          ; finished with list
  498.  
  499. vol.4
  500.           close:setint(""):print:clear key:goto volume
  501.  
  502.                          ; hang up
  503.                          ; ~~~~~~~
  504.  
  505.                          ; make sure user wishes to terminate call
  506.  
  507. hangup
  508.           input @2 "Hang up? (Y/[N]):" i$
  509.           if left$(i$,1)<>"Y" return
  510.           poke ram2+32,1:goto terminate
  511.  
  512.                          ; restore GBBS variables and link to the terminate code
  513.  
  514. terminate
  515.           poke ram2+32,3
  516.  
  517.                          ; SUBROUTINE - restore variables & do 1.3 conversions if needed
  518.  
  519. byecon
  520.           if cr<0 then cr=0
  521.           byte=ram2:byte(0)=xm:byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256
  522.           byte(5)=pt:byte(4)=pc:open #1,"d:xt.users":position #1,32,un:print #1,date$
  523.           position #1,32,un,10:write #1,ram2,6:close
  524.           poke ram2,v:when$=ram+20:if not(v) then byte=ram+29:goto byecon.1
  525.           byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
  526.           nibble(4)=ul/256:byte(4)=ul mod 256
  527.  
  528. byecon.1
  529.           print '
  530.                              ::::::::::::::::::::::::::::::::::::::::
  531.                             :    A.1 Computing~s Professional GBBS   :
  532.                              ::::::::::::::::::::::::::::::::::::::::'
  533.           flag=ram+22:clear:recall "d:variables":kill "d:variables":x=peek(ram2)
  534.           if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
  535.           if peek(ram2+32)=1 link "a:main.seg","termin2"
  536.           if peek(ram2+32)=2 link "a:main.seg","fromsys"
  537.           if peek(ram2+32)=3 link "a:main.seg","term1"
  538.  
  539.                          ; exit back to the board
  540.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  541.  
  542.                          ; make sure the user wants to exit back to the bulletin board
  543.  
  544. exit
  545.           input @2 "Exit back to the BBS? ([Y]/N):" i$
  546.           if left$(i$,1)="N" return
  547.  
  548.                          ; recall variables & add uploads & downloads
  549.  
  550. exit.1
  551.           poke ram2+32,2:goto byecon
  552.  
  553.                          ; routines to edit or create libraries
  554.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  555.  
  556. create
  557.           link "a:exfer.sys","create"
  558.  
  559.                          ; :::::::::::::::::::
  560.                          ; library subroutines
  561.                          ; :::::::::::::::::::
  562.  
  563.                          ; log to a library and get some dir info
  564.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  565.  
  566. log
  567.           byte=ram2:fill ram2,32,0:bf$="":z$="d:xv."+str$(bb)
  568.           open #1,z$:input #1,bn$:input #1,bf$
  569.           read #1,ram2,9:close:b1=byte(5)+byte(6)*256
  570.           b2=1:if byte(0) then b2=flag(byte(0))
  571.           b3=1:if byte(1) then b3=flag(byte(1))
  572.           b4=1:if byte(2) then b4=flag(byte(2))
  573.           um=byte(7):dm=byte(8):lb=(un=b1)
  574.           if info(5) then lb=1:b2=1:b3=1:b4=1
  575.           d1$="d:xv."+str$(bb):d2$="d:dv."+str$(bb)
  576.           if bf$ ready d2$:bf$=left$(bf$,instr(":",bf$))
  577.           return
  578.  
  579.                          ; get an empty slot
  580.                          ; ~~~~~~~~~~~~~~~~~
  581.  
  582. getslt
  583.           nb=0:open #1,d1$:for l=1 to byte(4)
  584.           position #1,32,l+1:input #1,i$
  585.           if (i$="") and (nb=0) then nb=l:l=byte(4)
  586.           next:close:if not(nb) then nb=byte(4)
  587.           return
  588.  
  589.                          ; update "number of entries" counter
  590.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  591. update
  592.           byte(4)=byte(4)+1
  593.           open #1,d1$:print #1,bn$
  594.           print #1,bf$:write #1,ram2,9:close
  595.  
  596.                          ; write a directory entry
  597.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  598. write
  599.           open #1,d1$:position #1,32,nb+1:print #1,na$
  600.           print #1,ty$:write #1,ram2+9,10:close
  601.           z=nb:return
  602.  
  603.                          ; read a directory entry
  604.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  605.  
  606. read
  607.           open #1,d1$:for l=1 to byte(4)
  608.           position #1,32,l+1:input #1,f$
  609.           if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
  610.           next:close #1:l=0:return
  611.  
  612. read.1
  613.           input #1,ty$:read #1,ram2+9,10:close #1
  614.           return
  615.  
  616.                          ; read a file by slot #
  617.                          ; ~~~~~~~~~~~~~~~~~~~~~
  618.  
  619. nread
  620.           if left$(i$,1)="#" then i$=mid$(i$,2)
  621.           l=val(i$):if (l<2) or (l>253) then l=0:return
  622.           open #1,d1$:position #1,32,l
  623.           input #1,f$:if f$="" close #1:l=0:return
  624.           input #1,ty$:read #1,ram2+9,10:close #1
  625.           i$=f$:if pt=2 return:else print xt$"[#"l"]: "i$:return
  626.  
  627.                          ; ::::::::::::::::::::::
  628.                          ; miscellaneous disk I/O
  629.                          ; ::::::::::::::::::::::
  630.  
  631.                          ; find the type of a file
  632.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  633.  
  634. dtype
  635.           use "d:xtyp",f$:x=peek(ram2+32)
  636.           x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
  637.           x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT200PAS239CMD240"
  638.           x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  639.           ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):goto id
  640.           ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
  641.  
  642.                          ; detect Macbinary or Binary ][ formats
  643.  
  644. id
  645.           x$=right$(f$,4)
  646.           if (x$=".BNY") or (x$=".BQY") or (x$=".SQZ") then ty$=right$(x$,3):return
  647.           open #1,f$:read #1,ram2+32,3:close #1
  648.           if (byte(32)=10) and (byte(33)=71) and (byte(34)=76) then ty$="BNY"
  649.           if (ty$="???") and ((byte(32)=0) and (byte(33))) then ty$="MAC"
  650.           return
  651.  
  652.                          ; set the type of a file
  653.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  654.  
  655. type
  656.           use "d:xtyp",f$,x:return
  657.  
  658.                          ; return the size of F$ in A
  659.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  660.  
  661. size
  662.           open #1,f$:a=size(1)/2+1:close:return
  663.  
  664.                          ; see if file exists
  665.                          ; ~~~~~~~~~~~~~~~~~~
  666.  
  667. chkfil
  668.           open #1,f$:a=mark(1):return
  669.  
  670.                          ; ::::::::::::::::::
  671.                          ; general processing
  672.                          ; ::::::::::::::::::
  673.  
  674.                          ; set up directory entry in RAM2
  675.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  676.  
  677. sfile
  678.           byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
  679.           byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
  680.           when$="x":if lb then byte(9)=255
  681.           return
  682.  
  683.                          ; convert user input to a valid ProDOS name
  684.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  685.  
  686.                          ; shorten I$ to directory length
  687.  
  688. name
  689.           if len(i$)>15 then i$=left$(i$,15)
  690.           i$=i$+chr$(1)
  691.  
  692.                          ; make sure the first char is a letter
  693.  
  694. name.0
  695.           a=asc(left$(i$,1)):if a=1 pop:return
  696.           if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
  697.           if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
  698.           i$=mid$(i$,2):goto name.0
  699.  
  700.                          ; remove symbols from the name
  701.  
  702. name.1
  703.           f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
  704.           if (a>64) and (a<91) goto name.2
  705.           if (a>96) and (a<123) goto name.2
  706.           if (a>47) and (a<58) goto name.2
  707.           if a=46 goto name.2:else goto name.3
  708.  
  709.                          ; add a valid character
  710.  
  711. name.2
  712.           f$=f$+chr$(a)
  713.  
  714.                          ; if we dont have a name, return to the prompt
  715.  
  716. name.3
  717.           next:if f$="" pop:return
  718.           if len(f$)>15 then f$=left$(f$,15)
  719.           return
  720.  
  721.                          ; :::::::::::::::::::::::::
  722.                          ; miscellaneous subroutines
  723.                          ; :::::::::::::::::::::::::
  724.  
  725.                          ; save user's stats before CLEAR
  726.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  727.  
  728. store
  729.           clear #8:byte=ram2:byte(0)=c:byte(1)=un mod 256
  730.           byte(2)=un/256:print #8,a1$,a2$,s$:return
  731.  
  732.                          ; recall a user's stats after CLEAR
  733.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  734.  
  735. recall
  736.           c=byte(0):un=byte(1)+byte(2)*256
  737.           input #8,a1$,a2$,s$:return
  738.  
  739.                          ; compute an "estimated time of transfer"
  740.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  741.  
  742. sendtime
  743.           x=bs/2:x=x+x/8:bs=bs*4:c=info(2)
  744.           if c=1 then b=x*34
  745.           if c=4 then b=x*9
  746.           if c=8 then b=x*4
  747.  
  748.                          ; The following 2 lines are for 4800 and 9600 baud. Delete the ; if needed
  749.                          ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  750.                          ; if c=16 then b=x
  751.                          ; if c=32 then b=x/2
  752.  
  753.           a=b/60:c=b mod 60:x=(clock(2)-clock(1))/60
  754.           bs=(byte(10)+byte(11)*256-(byte(10)>0))*4
  755.           return
  756.  
  757.                          ; get a file description
  758.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  759.  
  760. edesc
  761.           print '
  762. Enter     description: 'edit(3)' cols, [4K] max 
  763. [DONE]    when finished, [.H] for help'
  764.           edit(1):return
  765.  
  766.                          ; update errant bit-map
  767.                          ; ~~~~~~~~~~~~~~~~~~~~~
  768.  
  769. biterr
  770.           open #1,"d:xt.bitmap":read #1,ed+1,255:close
  771.           poke ed+l,255:open #1,"d:xt.bitmap"
  772.           write #1,ed+1,255:close:open #1,"d:xt.volumes"
  773.           position #1,32,l:print #1,chr$(13):close
  774.           return
  775.  
  776.                          ; ::::::::::::::
  777.                          ; error messages
  778.                          ; ::::::::::::::
  779.  
  780. lsec
  781.           print \xt$     ;chr$(7)"Security too low....":return
  782.  
  783. dfull
  784.           print xt$      ;chr$(7)"Directory full....":return
  785.  
  786. nfile
  787.           print xt$      ;chr$(7)"No such file....":return
  788.  
  789. unval
  790.           print xt$      ;chr$(7)'File must be validated before it
  791.              can be accessed....':return
  792.  
  793. trerr
  794.           print xt$      ;chr$(7)"ERROR in transfer......":return
  795.